home *** CD-ROM | disk | FTP | other *** search
/ Precision Software Appli…tions Silver Collection 4 / Precision Software Applications Silver Collection Volume 4 (1993).iso / new / mclk.arj / MCLK.PAS < prev    next >
Pascal/Delphi Source File  |  1993-08-19  |  2KB  |  100 lines
  1. program movingclock;
  2.  
  3. uses crt ,
  4.      dos ;
  5. const
  6.  progdata = 'MCLK- Free DOS utility: colorful moving clock display.';
  7.  progdat2 = 'V1.00: August 19, 1993. (c) 1993 by David Daniel Anderson - Reign Ware.';
  8.  usage = 'Usage:  MCLK';
  9. var
  10.     rtcol,
  11.     btrow,
  12.     xcord,
  13.     ycord   : byte ;
  14.     dum     : char ;
  15.  
  16. procedure showhelp;
  17. begin
  18.      writeln (progdata);
  19.      writeln (progdat2);
  20.      writeln (usage);
  21.      halt ;
  22. end;
  23.  
  24. procedure cursoroff ;
  25.  
  26. var
  27.   regs : registers ;
  28.  
  29. begin
  30. regs.ah:=$01 ;
  31. regs.ch:=$20 ;
  32. regs.cl:=$20 ;
  33. intr ( $10,regs) ;
  34. end ;
  35.  
  36. procedure cursoron ;
  37.  
  38. var
  39.   regs : registers ;
  40.  
  41. begin
  42. regs.ah:=$01 ;
  43. regs.ch:=$0 ;
  44. regs.cl:=$1 ;
  45. intr ( $10,regs) ;
  46. end ;
  47.  
  48. function leadingzero(w : word) : string;
  49. var
  50.   s : string;
  51. begin
  52.   str(w:0,s);
  53.   if length(s) = 1 then
  54.     s := '0' + s;
  55.   leadingzero := s;
  56. end;
  57.  
  58. procedure ddate;
  59. var
  60.     h,mi,s,u   : word ;
  61.     date_time  : datetime ;
  62. begin
  63.      gettime (h,mi,s,u);
  64.      with date_time do
  65.      begin
  66.           hour := ( h );
  67.        write ( leadingzero ( hour ) , ':' );
  68.           min  := ( mi );
  69.        write ( leadingzero ( min  ) , ':' );
  70.           sec  := ( s );
  71.        write ( leadingzero ( sec  ));
  72.      end;
  73. end;
  74.  
  75. begin
  76.     if paramcount <> 0 then showhelp;
  77.  
  78.     rtcol := lo ( windmax ) - 7 ;
  79.     btrow := hi ( windmax ) + 1 ;
  80.     textattr := 8;
  81.     clrscr ;
  82.     randomize ;
  83.     cursoroff ;
  84.  
  85.     while not keypressed do begin
  86.     textattr := succ ( textattr );
  87.     if ( textattr = 16 ) then
  88.          textattr := 9;
  89.     xcord := 1 + random ( rtcol ) ;
  90.     ycord := 1 + random ( btrow ) ;
  91.     gotoxy ( xcord , ycord );
  92.     ddate ;
  93.     delay ( 990 ) ;
  94.     clrscr ;
  95.     end;
  96.  
  97.     while keypressed do dum := readkey ;
  98.     cursoron ;
  99. end.
  100.